home *** CD-ROM | disk | FTP | other *** search
/ Merciful 4 / Merciful - Disc 4.iso / rexx / adpro / savers2 / _saveppaint
Text File  |  1995-09-19  |  1KB  |  70 lines
  1. /*
  2. ** _SavePPaint
  3. **
  4. ** $VER: _SavePPaint 1.0 (1995-09-16)
  5. **
  6. ** This program can be run as an ADPro saver to transfer
  7. ** the current ADPro buffer into Personal Paint's environment
  8. **
  9. ** This script requires ADPro v. 2.5.0 (or higher)
  10. **
  11. ** Copyright © 1995 Cloanto Italia srl - All Rights Reserved
  12. **
  13. */
  14.  
  15. PPPORT = 'PPAINT'
  16. ADPORT = 'ADPro'
  17.  
  18. IF ~SHOW('P', PPPORT) THEN DO
  19.     IF EXISTS('PPaint:PPaint') THEN DO
  20.         ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
  21.         DO 30 WHILE ~SHOW('P',PPPORT)
  22.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  23.         END
  24.     END
  25.     ELSE DO
  26.         ADDRESS VALUE ADPORT
  27.         ADPRO_TO_FRONT
  28.         OKAY1 "Personal Paint could not be loaded."
  29.         EXIT 10
  30.     END
  31. END
  32.  
  33. IF ~SHOW('P', PPPORT) THEN DO
  34.     ADDRESS VALUE ADPORT
  35.     OKAY1 'Personal Paint Rexx port could not be opened.'
  36.     EXIT 10
  37. END
  38.  
  39. tmpfname = 'T:pprx_temp.'PRAGMA('ID')
  40. tmpdefs  = 'T:adpro_defs.'PRAGMA('ID')
  41.  
  42. OPTIONS RESULTS
  43. ADDRESS VALUE ADPORT
  44.  
  45. SAVE_DEFAULTS tmpdefs
  46.  
  47. SAVER "PCX" tmpfname RAW    /* PCX is used to get a correct screen format */
  48. IF RC ~= 0 THEN DO
  49.     ADPRO_TO_FRONT
  50.     OKAY1 "ADPro failed to save the image."
  51. END
  52. ELSE DO
  53.     ADDRESS VALUE PPPORT
  54.     LoadImage '"'tmpfname'" FORCE QUIET'
  55.     IF RC ~= 0 THEN DO
  56.         ADDRESS VALUE ADPORT
  57.         ADPRO_TO_FRONT
  58.         OKAY1 "PPaint failed to load the image."
  59.     END
  60.     ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  61. END
  62.  
  63. ADDRESS VALUE ADPORT
  64. LOAD_DEFAULTS tmpdefs
  65. IF (RC ~= 0) THEN DO
  66.     ADPRO_TO_FRONT
  67.     OKAY1 "Error restoring settings."
  68. END
  69. ADDRESS COMMAND 'Delete >NIL: 'tmpdefs
  70.